home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Technotools
/
Technotools (Chestnut CD-ROM)(1993).ISO
/
lang_c
/
cuj9204
/
1004024a
< prev
next >
Wrap
Text File
|
1992-06-02
|
4KB
|
129 lines
/* Listing 1 */
typedef struct {
double X1, X2, X3, X4;
} ARG_D_4; /* vector 4 */
#include "float.h"
ARG_D_4 sin_4(xx1, xx2, xx3, xx4)
double xx1, xx2, xx3, xx4;
/* use where cos of same argument not needed
** 16 digits precision, compare to 15 digits in "dtrig.h"
** T C Prince */
{
union dblfmt {
double dbl;
int idbl;
struct dfmt { /* IEEE p754 */
unsigned int sign:1;
unsigned int ex:11;
} fmt;
} xi1;
double xr, x2, x4, x8;
#ifdef __STDC__
long double pi = 3.1415926535897932385, pml;
#include <limits.h>
#else
register double pi = 3.1415926535897932385, pml;
#define LONG_MIN 0x80000000
#endif
union dblfmt pm, round;
ARG_D_4 res;
#define BIAS DBL_MAX_EXP
#include <errno.h>
#ifndef errno
extern int errno;
#endif
#define ODD(i) ((i)&1)
/* use identity sin(x + n pi) = (-1)^n sin(x)
** to reduce range to -pi/2 < x < pi/2
** pml=rint(xi1/pi) */
#if FLT_ROUNDS != 1
#error "rounding mode not nearest; adjust code"
#endif
#if FLT_RADIX !=2 && FLT_RADIX != 10
#error "code not optimum for accuracy in this RADIX"
#endif
#if DBL_DIG > 16
#error "more terms needed for full accuracy"
#endif
/* shortcut test of sign, not portable to VAX */
round.dbl = 1 / LDBL_EPSILON;
xi1.dbl = xx1;
round.idbl |= xi1.idbl & LONG_MIN;
pml = xx1 / pi + round.dbl;
/* sign reversal may reduce register usage */
xr = pi * (pml -= round.dbl) - xx1;
/* shortcut test for fabs(pml) > INT_MAX */
pm.dbl = pml;
if (pm.fmt.ex > BIAS + 31)
errno = ERANGE;
/* don't wait to calculate xr**2 until sign is fixed;
** another sign reversal is due if pm.dbl is odd */
x2 = xr * xr;
/* first sign reversal compensated in coefficient signs;
** conditional sign fixed by testing odd/even
** first two results are obtained by straight Horner
** polynomial evaluation */
res.X1 = (-.9999999999999999 + x2 * (.1666666666666607
+ x2 * (-.833333333328281e-2 + x2 * (.19841269824875e-3
+ x2 * (-.2755731661057e-5 + x2 * (.25051882036e-7
+ x2 * (-.160481709e-9 + x2 * .7374418e-12)))))))
* (ODD((int) pm.dbl) ? -xr : xr);
/* sin(xi2) */
round.dbl = 1 / LDBL_EPSILON;
xi1.dbl = xx2;
round.idbl |= xi1.idbl & LONG_MIN;
pml = xx2 / pi + round.dbl;
xr = pi * (pml -= round.dbl) - xx2;
pm.dbl = pml;
if (pm.fmt.ex > BIAS + 31)
errno = ERANGE;
x2 = xr * xr;
res.X2 = (-.9999999999999999 + x2 * (.1666666666666607
+ x2 * (-.833333333328281e-2 + x2 * (.19841269824875e-3
+ x2 * (-.2755731661057e-5 + x2 * (.25051882036e-7
+ x2 * (-.160481709e-9 + x2 * .7374418e-12)))))))
* (ODD((int) pm.dbl) ? -xr : xr);
/* sin(xi3) */
round.dbl = 1 / LDBL_EPSILON;
xi1.dbl = xx3;
round.idbl |= xi1.idbl & LONG_MIN;
pml = xx3 / pi + round.dbl;
xr = pi * (pml -= round.dbl) - xx3;
pm.dbl = pml;
if (pm.fmt.ex > BIAS + 31)
errno = ERANGE;
x2 = xr * xr;
x4 = x2 * x2;
/* split into 2 Horner polynomials to increase
** parallelism after 1st result finishes */
res.X3 = (-.9999999999999999 + x2 * (.1666666666666607
+ x2 * (-.833333333328281e-2
+ x2 * .19841269824875e-3))
+ (-.2755731661057e-5 + x2 * (.25051882036e-7
+ x2 * (-.160481709e-9
+ x2 * .7374418e-12))) * x4 * x4) *
(ODD((int) pm.dbl) ? -xr : xr);
/* sin(xi4) */
round.dbl = 1 / LDBL_EPSILON;
xi1.dbl = xx4;
round.idbl |= xi1.idbl & LONG_MIN;
pml = xx4 / pi + round.dbl;
xr = pi * (pml -= round.dbl) - xi1.dbl;
/* errno is set to ERANGE if any of the arguments are too
** large for reasonable range reduction */
pm.dbl = pml;
if (pm.fmt.ex > BIAS + 31)
errno = ERANGE;
x2 = xr * xr;
x4 = x2 * x2;
x8 = x4 * x4;
/* multiply by 1 is K&R way to enforce parentheses */
res.X4 = ((-.9999999999999999 + x2 * (.1666666666666607
+ x2 * (-.833333333328281e-2
+ x2 * .19841269824875e-3))) * 1
+ (-.2755731661057e-5 + x2 * (.25051882036e-7
+ x2 * (-.160481709e-9 + x2 * .7374418e-12))) * x8)
* (ODD((int) pm.dbl) ? -xr : xr);
return res;
}